perm filename M11A.F4[P11,LCS]4 blob
sn#367614 filedate 1978-07-10 generic text, type T, neo UTF8
CPASS3 PASS 3 MAIN PROGRAM
C *** MUSIC V ***
C DATA SPECIFICATION
INTEGER PEAK
DIMENSION T(50),TI(50),ITI(50)
COMMON I(513) /P/P(50)/PARM/IP(20)/FINOUT/PEAK,NRSOR,IPEAK
1 /GENS/IGN(3200)
COMMON /INS/INS(400),IDEF(100) /NT/NT(1000) /IOUT/IOUT(1536)
C INS=INSTRUMENT DEFINITIONS, IDEF=LOCATION TABLE, IOUT=OUTPUT BLOCK
EQUIVALENCE (IP9,IP(9)),(I2,I(2)),(I6,I(6)),(I5,I(5)),(T3,T(3))
1,(T2,T(2)),(P3,P(3))
CC******* DATA IIIRD/Z5EECE66D/
DATA IIIRD/976545367/
C SET I ARRAY =0 (7/10/69)
CCC DATA I/4000*0/,I(4)/12800/
C**************
C INIALIZATION OF PIECE
C IIIRD - ARBITRARY STARTING NUMBER FOR SUBROUTINE RANDU
CCC DO 801 K=1,4000
CCC801 I(K)=0
I(7)=IIIRD
C****** SEE BLOCK DATA RE. SCALE FACTORS ********* IP(12)=2**8
PEAK=0
NRSOR=0
IPEAK=0
C IPEAK AND PEAK USED TO TYPE OUT AMPL. INFO. LATER.
CC******* NREAD = 3
CC******* NWRITE = 2
NREAD=21
C PDP DSK1=DEV.21
NWRITE=1
C PDP DSK=DEV.1
REWIND NREAD
REWIND NWRITE
TYPE 401
ACCEPT 501 ,FLNM,IDSK
C TYPE 'PASS2' OR FILENAME + ANY POS.NUMB. TO WRITE SMPLS ON DSK.
IF(FLNM.EQ.' '.OR.FLNM.EQ.'PASS2')FLNM='FOR21'
CALL IFILE(21,FLNM)
IF(IDSK.NE.0)GO TO 601
CALL OFILE(23,'TEST')
GO TO 701
401 FORMAT(' TYPE FILE NAME'/)
501 FORMAT(A5,I)
601 IDSK=-1
701 SCLFT=IP(12)
I2=1
CC I(2)=IP(4)
CC MS1=IP(7)
MS1=1
MS3=MS1+(IP(8)*IP9)-1
MS2=IP(8)
I(4)=IP(3)
MOUT=1
CC MOUT=IP(10)
C INITIALIZATION OF SECTION
5 T(1)=0.0
DO 220 N1=MS1,MS3,MS2
C INITS POSSIBLE NUM OF NOTES THAT CAN PLAY AT ONCE (27 NOW)
220 NT(N1)=-1
DO 221N1=1,IP9
221 TI(N1)=90909.
C MAIN CARD READING LOOP
204 CALL DATA (NREAD)
IF(P(2)-T(1))200,200,244
200 IOP=P(1)
IF(IOP)201,201,202
201 CALLERROR(1)
GO TO 204
202 IF(IP(1)-IOP)201,203,203
203 GO TO (1,2,3,4,5,6,201,201,201,201,11,11),IOP
11 IVAR=P3
IVARE=IVAR+I(1)-4
DO 297 N1=IVAR,IVARE
IVARP=N1-IVAR+4
297 NT(N1)=P(IVARP)
GO TO 204
3 IGEN=P3
IF(IGEN.NE.1)GO TO 282
CCC **** ONLY GEN1,GEN2 IN THIS VERSION GO TO (281,282,283,284,285),IGEN
281 CALLGEN1
GO TO 204
282 IF(IGEN.GT.2)PAUSE ' ONLY GEN1 AND GEN2 FOR NOW'
CALLGEN2
GO TO 204
CCC 283 CALLGEN3
CCC GO TO 204
CCC 284 CALLGEN4
CCC GO TO 204
CCC 285 CALLGEN5
CCC GO TO 204
4 IVAR=P3
IVARE=IVAR+I(1)-4
DO 296N1=IVAR,IVARE
IVARP=N1-IVAR+4
296 I(N1+100)=P(IVARP)*SCLFT
GO TO 204
6 CALL FROUT3(IDSK)
STOP
C ENTER NOTE TO BE PLAYED
1 DO 230N1=MS1,MS3,MS2
230 IF(NT(N1).EQ.-1)GO TO 231
CALLERROR(2)
C TOO MANY NOTES(27 LIMIT FOR NOW) TRYING TO PLAY AT ONCE.
TYPE 1230,IP(9)
GO TO 204
1230 FORMAT(' TOO MANY NOTES AT ONCE. LIMIT=',I2/)
231 M1=N1
M2=N1+I(1)-1
M3=M2+1
M4=N1+IP(8)-1
DO 232N1=M1,M2
M5=N1-M1+1
232 NT(N1)=P(M5)*SCLFT
NT(M1 )=P3
DO 233N1=M3,M4
233 NT(N1)=0
DO 235N1=1,IP9
IF(TI(N1)-90909.)235,234,235
234 TI(N1)=P(2)+P(4)
ITI(N1)=M1
GO TO 204
235 CONTINUE
CALLERROR(3)
GO TO 204
C DEFINE INSTRUMENT
2 M1=I2
CQQ M2=IP(5)+IFIX(P3)
M2=IFIX(P3)
IDEF(M2)=M1
218 CALL DATA (NREAD)
IF(I(1)-2)210,210,211
210 INS(M1)=0
I2=M1+1
GO TO 204
211 INS(M1)=P3
M3=I(1)
INS(M1+1)=M1+M3-1
M1=M1+2
DO 217N1=4,M3
M5=P(N1)
IF(M5)212,213,213
212 IF(M5+100)300,301,301
300 INS(M1)=-1+(M5+101)*IP(6)
CCC 300 INS(M1)=-IP(2)+(M5+101)*IP(6)
GO TO 216
301 INS(M1)=-1+(M5+1)*IP(14)
CC301 I(M1)=-IP(13)+(M5+1)*IP(14)
GO TO 216
213 IF(M5- 100 )214,214,215
214 INS(M1)=M5
GO TO 216
215 INS(M1)=M5+26262
CCC215 I(M1)=M5+262144
C****** WHAT DOES THIS BIG NUM.(2**18) DO?? ***********
C*** IT SEEMS TO BE JUST TO MAKE A FLAG. NOW CHANGED TO FIT INTO 16BITS.
216 M1=M1+1
217 CONTINUE
GO TO 218
C PLAY TO ACTION TIME
244 T2=P(2)
250 TMIN=90909.
IREST=1
DO 241N1=1,IP9
IF(TMIN-TI(N1))241,241,240
240 TMIN=TI(N1)
MNOTE=N1
241 CONTINUE
IF(90909.-TMIN)251,251,243
243 IF(TMIN-T2)245,245,246
245 T3=TMIN
GO TO 260
246 T3=T2
GO TO 260
247 IF(T(1)-T2)249,200,200
249 TI(MNOTE)=90909.
M2=ITI(MNOTE)
NT(M2)=-1
GO TO 250
C SETUP REST
251 T3=T2
IREST=2
GO TO 260
C PLAY
260 ISAM=(T3-T(1))*FLOAT(I(4))+.5
T(1)=T3
IF(ISAM)247,247,266
266 IF(ISAM-IP(14))262,262,263
262 I5=ISAM
ISAM=0
GO TO 264
263 I5=IP(14)
ISAM=ISAM-IP(14)
264 IF(I(8))290,290,291
290 M3=MOUT+I5-1
MSAMP=I5
GO TO 292
291 M3=MOUT+(2*I5)-1
MSAMP=2*I5
292 DO 267N1=MOUT,M3
267 IOUT(N1)=0
GO TO (268,265),IREST
268 DO 270NS1=MS1,MS3,MS2
IF(NT(NS1)+1)271,270,271
C GO THROUGH UNIT GENERATORS IN INSTRUMENT
271 I(3)=NS1
IGEN=NT(NS1)
CC IGEN=IP(5)+I(NS1)
IGEN=IDEF(IGEN)
272 I6=IGEN
CC***** IF(I(IGEN)-101)293,294,294
CC***** 293 CALLSAMGEN(I)
C**** ABOVE FOR MACHINE LANG. UNIT GENERATORS *******
CC***** GO TO 295
294 CALLFORSAM
295 IGEN=INS(IGEN+1)
IF(INS(IGEN))270,270,272
270 CONTINUE
265 CALL SAMOUT(IDSK ,MSAMP)
IF(ISAM)247,247,266
END